home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr50
/
pbc22b.zip
/
PBC$BAS.ZIP
/
CALCDATE.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-01
|
1KB
|
39 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
DECLARE SUB CheckDate (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, ErrCode%)
DECLARE SUB DateA2R (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, RelDate&)
DECLARE SUB DateN2S (MonthNr%, DayNr%, YearNr%, DateSt$)
DECLARE SUB DateR2A (MonthNr%, DayNr%, YearNr%, RelDate&)
SUB CalcDate (StartDate$, Days&, Direction%, NewDate$, ErrCode%)
M% = VAL(StartDate$)
D% = VAL(MID$(StartDate$, 4))
Y% = VAL(MID$(StartDate$, 7))
IF Y% < 100 THEN Y% = Y% + 1900
CheckDate M%, D%, Y%, ErrCode%
IF ErrCode% THEN
ErrCode% = 2
EXIT SUB
END IF
DateA2R M%, D%, Y%, SDate&
IF Direction% THEN
SDate& = SDate& - Days&
ELSE
SDate& = SDate& + Days&
END IF
IF SDate& < 0& THEN
ErrCode% = 3
EXIT SUB
END IF
ErrCode% = 0
DateR2A M%, D%, Y%, SDate&
NewDate$ = StartDate$
DateN2S M%, D%, Y%, NewDate$
END SUB